unit WebApi_Swagger;

interface

uses
  SysUtils, DateUtils, Classes, StrUtils, TypInfo, Rtti, WebAPI_Controller;

type
  TSwagger = class
  private
    _RTTIContext: TRttiContext;
    remarks: string;
    function getBaseType(btype: TRttiType): string;
  public
    procedure init();
    function text: string;
  end;

implementation

{ TSwagger }

function TSwagger.getBaseType(btype: TRttiType): string;
var
  bt: TRttiType;
begin
  bt := btype;
  Result := '';
  while Assigned(bt) do
  begin
    if bt.Handle.Name <> 'TObject' then
    begin
      Result := bt.ToString;
    end;
    bt := bt.BaseType;
  end;
end;

procedure TSwagger.init;
var
  ms: TArray<TRttiMethod>;
  tts: TArray<TRttiType>;
  tt: TRttiType;
//  cl: TClass;
  method: TRttiMethod;
  classname: string;
  AttrMethod, AttrClass: TCustomAttribute;
  RouteName, s: string;
  Path: string;
  tablename: string;
  httpmethod: string;
  html: string;
begin
  html := '<html><body>';
  tts := _RTTIContext.GetTypes;
  for tt in tts do
  begin
    if (tt.Handle.Kind = TTypeKind.tkClass) then
    begin
      RouteName := tt.ToString;
      if Assigned(tt.BaseType) then
      begin
        classname := getBaseType(tt.BaseType);
        if classname = 'TApiController' then
        begin
        //  cl := tt.AsInstance.MetaclassType;
          RouteName := 'null';
          for AttrClass in tt.GetAttributes do
          begin
            if AttrClass is TRoute then
            begin
              with TRoute(AttrClass) do
              begin
                RouteName := FPath;
              end;
            end;
            if AttrClass is TTable then
            begin
              with TTable(AttrClass) do
              begin
                tablename := FTableName;
              end;
            end;
          end;
          if RouteName <> 'null' then
          begin
            if RouteName = '' then
              s := '/'
            else
              s := RouteName;
            html := html + '<div style="margin-left: auto;margin-right: auto;width: 70%;">';
            html := html + '<div style="padding: 8px;"><h3>' + s + '</h3></div>';
          end;

          ms := tt.GetMethods;
          for method in ms do
          begin
            Path := '';

            for AttrMethod in method.GetAttributes do
            begin
              if AttrMethod is TPath then
              begin
                with TPath(AttrMethod) do
                begin
                  Path := FPath;
                  httpmethod := getMethodType();
                end;
              end;
            end;

            if (Path <> '') and (RouteName <> 'null') then
            begin
              if httpmethod = '' then
                httpmethod := 'GET,POST';
              httpmethod := '[' + httpmethod + ']';
              html := html + '<div style="background-color:antiquewhite; border-radius: 5px; border: 1px solid burlywood;margin: 1px;padding: 8px;">'
                + httpmethod + '  ' + Path + '</div>';
            end;
          end;
          html := html + '</div>';
        end;
      end;
    end;
  end;
  html := html + '<html><body>';
  remarks := html;
end;

function TSwagger.text: string;
begin
  Result := remarks;
end;

end.

